home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Contributed Scores / Peter Stone Punctus / SuperStrings < prev    next >
Lisp/Scheme  |  1998-10-26  |  8KB  |  190 lines
  1. (defun pep-to-chord-1 (pep)
  2.      (cadr (assoc pep '(
  3.         (a (f 2  g# 2  c 3  f 4))
  4.         (b (g 2  c# 3  c# 3  e 3))
  5.         (c (f 2  c# 3  f 2  c# 3))
  6.         (d (c 2  d# 2  d 2  g 2))))))
  7.  
  8. (defun pep-to-chord-2 (pep)
  9.      (cadr (assoc pep '(
  10.         (a (c 2 f 2 g 2 c 2))
  11.         (b (a# 2  a# 2  f 3  c 3))
  12.         (c (c# 3  a# 2  c# 3 g 2))
  13.         (d (g 2  g 2  f# 2  c# 2))))))
  14.  
  15. (defun pep-to-chord-3 (pep)
  16.      (cadr (assoc pep '(
  17.         (a (f 3  g# 3 a# 3 c 3))
  18.         (b (a# 3 a# 3 f 3  c 3))
  19.         (c (g 3  g 3  g 4  g 3))
  20.         (d (g 3  g 3  f# 3 c# 3))))))
  21.  
  22. (defun pep-to-chord (pep type transp)
  23.    (cond ((equal type '1)
  24.           (transpose-chord (pep-to-chord-1 pep) transp))
  25.          ((equal type '2)
  26.           (transpose-chord (pep-to-chord-2 pep) transp))
  27.          ((equal type '3)
  28.           (transpose-chord (pep-to-chord-3 pep) transp))
  29.          (t (diagnostic (list "illegal type in pep-to-chord" $cr$)))))
  30.  
  31. (defun pep-to-trans (pep)
  32.   (cadr (assoc pep '((a 0)
  33.                      (b -2)
  34.                      (c 5)
  35.                      (d 7)))))
  36.  
  37. (defun peps-to-chords (peps type trans-len)
  38.   (prog (out trans-val chord-val count transpeps)
  39.     (cond ((null trans-len) (setq trans-len 4)))
  40.     (setq transpeps peps)
  41.     (setq count trans-len)
  42.     loop
  43.     (cond ((null peps) (return (reversewoc out))))
  44.     (cond ((equal count trans-len)
  45.            (setq trans-val (pep-to-trans (car transpeps)))
  46.            (setq transpeps (cdr transpeps))
  47.            (setq count 1))
  48.           (t (setq count (add1 count))))
  49.     (setq chord-val (pep-to-chord (car peps) type trans-val))
  50.     (setq out (xcons out chord-val))
  51.     (setq peps (cdr peps))
  52.     (go loop)))
  53.  
  54. (setq samples 4096)
  55. (setq mod 0.1)
  56. (setq rdepth 2)
  57.  
  58. (setq circle1
  59.    '(gen-sin 10 mod samples 0
  60.       (vector-mix (gen-sin 9 mod samples 0
  61.               (vector-mix (gen-sin 8 mod samples 0
  62.                       (vector-mix (gen-sin 7 mod samples 0
  63.                               (vector-mix (gen-sin 6 mod samples 0
  64.                                       (vector-mix (gen-sin 5 mod samples 0
  65.                                               (vector-mix (gen-sin 4 mod samples 0
  66.                                                       (vector-mix (gen-sin 3 mod samples 0
  67.                                                               (vector-mix (gen-sin 2 mod samples 0
  68.                                                                       (vector-mix (gen-sin 1 mod samples 0
  69.                                                                                (vector-mix x (gen-sin 4 mod samples 0)))                                    
  70.                                                                            (gen-sin 5 mod samples 0)))  
  71.                                                                    (gen-sin 6 mod samples 0)))
  72.                                                            (gen-sin 7 mod samples 0)))
  73.                                                    (gen-sin 8 mod samples 0)))
  74.                                            (gen-sin 9 mod samples 0)))
  75.                                    (gen-sin 10 mod samples 0)))
  76.                            (gen-sin 1 mod samples 0)))
  77.                    (gen-sin 2 mod samples 0)))
  78.            (gen-sin 3 mod samples 0))))
  79.  
  80. (setq circle2
  81.    '(gen-sin 4 mod samples 0
  82.       (vector-mix (gen-sin 3 mod samples 0
  83.               (vector-mix (gen-sin 2 mod samples 0
  84.                       (vector-mix (gen-sin 1 mod samples 0
  85.                               (vector-mix (gen-sin 10 mod samples 0
  86.                                       (vector-mix (gen-sin 9 mod samples 0
  87.                                               (vector-mix (gen-sin 8 mod samples 0
  88.                                                       (vector-mix (gen-sin 7 mod samples 0
  89.                                                               (vector-mix (gen-sin 6 mod samples 0
  90.                                                                       (vector-mix (gen-sin 5 mod samples 0
  91.                                                                               (vector-mix x (gen-sin 8 mod samples 0)))
  92.                                                                            (gen-sin 9 mod samples 0)))
  93.                                                                    (gen-sin 10 mod samples 0)))
  94.                                                            (gen-sin 1 mod samples 0)))
  95.                                                    (gen-sin 2 mod samples 0)))
  96.                                            (gen-sin 3 mod samples 0)))
  97.                                    (gen-sin 4 mod samples 0)))
  98.                            (gen-sin 5 mod samples 0)))
  99.                    (gen-sin 6 mod samples 0)))
  100.            (gen-sin 7 mod samples 0))))
  101.  
  102. (setq circle3
  103.    '(gen-sin 6 mod samples 0
  104.       (vector-mix (gen-sin 5 mod samples 0
  105.               (vector-mix (gen-sin 4 mod samples 0
  106.                       (vector-mix (gen-sin 3 mod samples 0
  107.                               (vector-mix (gen-sin 2 mod samples 0
  108.                                       (vector-mix (gen-sin 1 mod samples 0
  109.                                               (vector-mix (gen-sin 10 mod samples 0
  110.                                                       (vector-mix (gen-sin 9 mod samples 0
  111.                                                               (vector-mix (gen-sin 8 mod samples 0
  112.                                                                       (vector-mix (gen-sin 7 mod samples 0
  113.                                                                               (vector-mix x (gen-sin 10 mod samples 0)))
  114.                                                                            (gen-sin 1 mod samples 0)))
  115.                                                                    (gen-sin 2 mod samples 0)))
  116.                                                            (gen-sin 3 mod samples 0)))
  117.                                                    (gen-sin 4 mod samples 0)))
  118.                                            (gen-sin 5 mod samples 0)))
  119.                                    (gen-sin 6 mod samples 0)))
  120.                            (gen-sin 7 mod samples 0)))
  121.                    (gen-sin 8 mod samples 0)))
  122.            (gen-sin 9 mod samples 0))))
  123.  
  124. (setq vhorn (self-modulate circle1 rdepth 2))
  125. (setq vstrings (self-modulate circle2 rdepth 2))
  126. (setq vpizzicato (self-modulate circle3 rdepth 2))
  127.  
  128. (def-orchestra 'orchestra
  129.    all (horn strings pizzicato)
  130.    strings (strings1 strings2)
  131. )
  132.  
  133. (setq tempo-zone-len (/ (get-ratio '256/1 :ratio)
  134.                         (get-ratio '1/8 :ratio)))
  135.  
  136. ; note: tuning is synthesizer specific, decrease/increase accordingly
  137. ; it's purpose here is to detune everything slightly
  138.  
  139. (def-section sect-a
  140.   default
  141.     zone (symbol-repeat 256 '(1/1))
  142.     tempo-zones (symbol-trim tempo-zone-len '(1/8))
  143.     tempo (vector-to-list (vector-round 77 85 vstrings))
  144.   horn
  145.     channel 1 
  146.     tonality (peps-to-chords (vector-to-symbol a d vhorn) 1 4)
  147.     symbol (vector-to-symbol a l vhorn)
  148.     length '(1/16)
  149.     duration '(1/25)
  150.     velocity (vector-round 50 95 vstrings)
  151.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white samples 1 0.1212)))
  152.   strings1
  153.     channel 2 
  154.     tonality (peps-to-chords (vector-to-symbol a d vstrings) 2 4)
  155.     symbol (vector-to-symbol a l vstrings)
  156.     length '(1/16)
  157.     duration '(1/25)
  158.     velocity (vector-round 50 95 vpizzicato)
  159.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white samples 1 0.2212)))
  160.   pizzicato
  161.     channel 3 
  162.     tonality (peps-to-chords (vector-to-symbol a d vpizzicato) 3 4)
  163.     symbol (vector-to-symbol a l vpizzicato)
  164.     length '(1/16)
  165.     duration '(1/25)
  166.     velocity (vector-round 60 95 vhorn)
  167.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white samples 1 0.3212)))
  168.   strings2
  169.     channel 6 
  170.     tonality (peps-to-chords (vector-to-symbol a d vstrings) 2 4)
  171.     symbol (vector-to-symbol a l vstrings)
  172.     length '(1/16)
  173.     duration '(1/25)
  174.     velocity (vector-round 50 95 vpizzicato)
  175.     tuning (vector-to-list (vector-round -300 300 (gen-noise-white samples 1 0.22212)))
  176. )
  177.  
  178. (init-rnd 0.223541)
  179.  
  180. ;(def-expression
  181. ;    horn ((legato 100 10 0.34) (humanize 0 2 0.14) (velocity 2 0.42))
  182. ;    strings ((legato 100 10 0.34) (humanize 0 2 0.14) (velocity 2 0.42))
  183. ;    pizzicato ((legato 100 10 0.34) (humanize 0 2 0.14) (velocity 2 0.42))
  184. ;)
  185.  
  186. (play-file-p nil
  187.   all '(sect-a)
  188. )
  189.  
  190.